SuperHack/SuperHack CD.bin/CODING/DEMOS/BLA2SRC.ZIP/CONVCMF.PAS

Pascal/Delphi Source File | 1994-02-12 | 12.2 KB | 432 lines

USES Objects, Dos, HexConversions;


TYPE
  TBuf = ARRAY[0..65520] OF BYTE;
CONST
  SizeMusic : WORD  = 0;
  Music     : ^TBuf = NIL;
  DBcol     : BYTE  = 48;


PROCEDURE PutByte(VAR f: TEXT; b: BYTE);
  BEGIN
    Music^[SizeMusic] := b;
    INC(SizeMusic);
  END;


PROCEDURE PutByteFile(VAR f: TEXT; b: BYTE);
  BEGIN
    IF DBcol = 48 THEN
      BEGIN
        WriteLn(f);
        Write(f, '    DB ');
        DBcol := 1;
      END
    ELSE IF DBcol <> 0 THEN
      Write(f, ',');

    inc (DBcol);
    Write(f, '0', HexByte(b), 'h');
  END;



VAR
  St       : TBufStream;
  f        : TEXT;
  s        : STRING;
  v, r, p  : WORD;
  vl       : WORD;
  i, j, k  : WORD;
  time,
  otime,
  ntime,
  delta, dl: LONGINT;
  change   : BOOLEAN;
  buf      : ARRAY[1..256] OF BYTE;
  Patches  : ARRAY[0..15] OF BYTE;
  ChPatch  : ARRAY[0..8] OF BYTE;
  Volumes  : ARRAY[0..8] OF BYTE;
  Channels : ARRAY[0..8] OF LONGINT;

  Midi     : ARRAY[0..15,1..4] OF BYTE;

  KeyOn    : ARRAY[0..8] OF RECORD
                              ins,
                              freq,
                              vol   : BYTE;
                            END;
  KeyOff   : ARRAY[0..8] OF BOOLEAN;

LABEL
  Fin;

BEGIN

  New(Music);

  FOR i := 0 TO  8 DO ChPatch[i] := i;
  FOR i := 0 TO 15 DO Patches[i] := i;

  FillChar(Volumes,  SizeOf(Volumes),    0);
  FillChar(Channels, SizeOf(Channels),   0);
  FillChar(Midi,     SizeOf(Midi),     255);

  St.Init(ParamStr(1), stOpenRead, 16384);
  Assign(f, ParamStr(2));
  Rewrite(f);

  WriteLn(f, '; --------------------------------');
  WriteLn(f, '; Converted CMF File: '+ParamStr(1));
  WriteLn(f, '; (C) 1994 bye JCAB/VangeliSTeam');
  WriteLn(f);
  WriteLn(f, '; === Instruments');

  v := 0;
  St.Seek(36);
  St.Read(v, 1);
  STR(v, s);
  WriteLn(f);
  WriteLn(f, 'CMF_NInstruments = ', s);

  St.Seek(6);
  St.Read(r, 2);
  St.Seek(r);
  WriteLn(f);
  WriteLn(f, 'CMF_Instruments:');
  FOR i := 1 TO v DO
    BEGIN
      St.Read(buf, 16);
      Write(f, '    DB ');
      FOR j := 1 TO 11 DO
        BEGIN
          Write(f, '0', HexByte(buf[j]), 'h');
          IF j < 11 THEN
            Write(f, ', ')
          ELSE
            WriteLn(f);
        END;
    END;

  WriteLn(f);
  WriteLn(f, '; === Data');

  St.Seek(8);
  St.Read(v, 2);
  St.Seek(v);
  time := 0;
  otime := 0;
  WHILE St.Status = stOk DO
    BEGIN

IF time = 6 THEN
      delta := 0;
      delta := 0;
      r     := 0;
      REPEAT
        dl := 0;
        REPEAT
          St.Read(r, 1);
          IF St.Status <> stOk THEN GOTO Fin;
          dl := 128*dl + (r AND $7F);
        UNTIL (r AND $80) = 0;
        delta := delta + dl;

        St.Read(r, 1);
        IF r < $80 THEN
          BEGIN
            r := v;
            St.Seek(St.GetPos-1);
          END;
        IF ((r AND $F0) = $D0) THEN
          BEGIN
            St.Read(r, 1);
            r := 0;
          END
        ELSE IF ((r AND $F0) = $B0) THEN
          BEGIN
            St.Read(r, 1);
            St.Read(r, 1);
            r := 0;
          END

      UNTIL r <> 0;
      v := r;

      INC(time, delta);
      ntime := time+3 - ((time+3) MOD 6);
      delta := (ntime - otime) DIV 6;

      IF delta > 0 THEN
        BEGIN
          otime := ntime;
          IF delta > 15 THEN
            BEGIN
              PutByte(f, $E0+((delta-1) SHR 8));
              PutByte(f, (delta-1) AND 255);
            END
          ELSE
            PutByte(f, $D0+delta-1);
        END;

      IF v = 255 THEN GOTO Fin;

      CASE v AND $F0 OF
        $80: BEGIN

               r := 0;
               St.Read(r, 1);
               IF ((v AND 15) = 0) OR TRUE THEN
                 BEGIN
                   p := 0;
                   FOR i := 0 TO 8 DO
                     IF Midi[v AND 15][i] = r THEN
                       BEGIN
                         Midi[v AND 15][i] := 255;
                         p := i;
                         i := 8;
                       END;
                   PutByte(f, $90+p);
                 END;
               Channels[p] := time;
               St.Read(vl, 1);
             END;
        $90: BEGIN
               j := time+1;
               p := 0;
               IF ((v AND 15) = 0) OR TRUE THEN
                 BEGIN
                   FOR i := 0 TO 8 DO
                     BEGIN
                       IF (time+1 > Channels[i]) AND
                          (Patches[v AND 15] = ChPatch[i]) THEN
                         BEGIN
                           j := time+1;
                           FOR i := i TO 8 DO
                             IF (j > Channels[i]) AND
                                (Patches[v AND 15] = ChPatch[i]) THEN
                               BEGIN
                                 j := Channels[i];
                                 p := i;
                               END;
                         END
                       ELSE
                         IF j > Channels[i] THEN
                           BEGIN
                             j := Channels[i];
                             p := i;
                           END;
                     END;
{                   p := v AND 15;}
                   Channels[p] := $7FFFFFF;
                   IF Patches[v AND 15] = ChPatch[p] THEN
                     PutByte(f, (p SHL 4))
                   ELSE
                     BEGIN
                       PutByte(f, (p SHL 4)+Patches[v AND 15]+1);
                       Volumes[p] := 255;
                       ChPatch[p] := Patches[v AND 15];
                     END;
                   r := 0;
                   St.Read(r, 1);
                   Midi[v AND 15][p] := r;
                   vl := 0;
                   St.Read(vl, 1);
                   vl := vl + $80 + $08;
                   IF vl > 255 THEN vl := 255;
                   vl := vl AND $F0;
                   vl := $FE;
                   IF (vl <> Volumes[p]) {OR TRUE} THEN
                     BEGIN
                       PutByte(f, r+$80);
                       IF vl > 0 THEN
                         PutByte(f, vl)
                       ELSE
                         PutByte(f, 0);
                     END
                   ELSE
                     PutByte(f, r);
                   Volumes[p] := vl;
                 END
               ELSE
                 BEGIN
                   St.Read(r,  1);
                   St.Read(vl, 1);
                 END;
             END;
        $C0: BEGIN
               r := 0;
               St.Read(r, 1);
               Patches[v AND 15] := r;
             END;
        $D0: BEGIN
               r := 0;
               St.Read(r, 1);
             END;
      ELSE
          WriteLn('ORROR. Comando: ', v);
          WriteLn('Offset: ', St.GetPos);
          WriteLn('Time: ', time);
          WriteLn('Delta: ', delta);
          HALT(1);
      END;

    END;

Fin:
  PutByte(f, $FF);

  FOR k := 0 TO 3 DO
    BEGIN
      WriteLn(f);
      Write  (f, 'CMF_Data', k, ':');

      FillChar(KeyOn,  SizeOf(KeyOn),  255);
      FillChar(KeyOff, SizeOf(KeyOff),   0);
      delta := 0;
      time  := 0;
      FOR i := 0 TO SizeMusic-1 DO
        BEGIN
          v := Music^[i] SHR 4;
          r := Music^[i] AND 15;
          CASE v OF
            0..8: BEGIN
                    KeyOn[v].ins  := r;
                    KeyOn[v].freq := Music^[i+1];
                    IF (Music^[i+1] AND $80) <> 0 THEN
                      BEGIN
                        KeyOn[v].vol := Music^[i+2];
                        INC(i);
                      END;
                    INC(i);
                    IF k <> ChPatch[v] THEN KeyOn[v].ins := 255;
                  END;
            9:    KeyOff[r] := TRUE;
            $D,
            $E,
            $F:
                  BEGIN
                    change := FALSE;
                    FOR j := 0 TO 8 DO
                      IF KeyOn[j].ins < 255 THEN
                        change := TRUE;

                    IF change OR (v = $F) THEN
                      BEGIN
                        DBcol := 48;
                        IF time DIV 32 < (time+delta) DIV 32 THEN
                          BEGIN
                            dl := time+delta;
                            dl := (dl - dl MOD 32) - time;
                            IF dl > 16 THEN
                              BEGIN
                                PutByteFile(f, $E0+((dl-1) SHR 8));
                                PutByteFile(f, (dl-1) AND 255);
                              END
                            ELSE
                              BEGIN
                                PutByteFile(f, $D0+dl-1);
                                Write(f, '     ');
                              END;
                            time  := time  + dl;
                            delta := delta - dl;
                            WriteLn(f);

                            DBcol := 48;
                          END;
                        IF delta = 0 THEN
                          BEGIN
                            WriteLn(f);
                            Write(f, '    DB           ');
                            DBcol := 0;
                          END;
                        IF delta > 0 THEN
                          BEGIN
                            IF delta > 16 THEN
                              BEGIN
                                PutByteFile(f, $E0+((delta-1) SHR 8));
                                PutByteFile(f, (delta-1) AND 255);
                              END
                            ELSE
                              BEGIN
                                PutByteFile(f, $D0+delta-1);
                                Write(f, '     ');
                              END;
                          END;
                        time  := time + delta;
                        delta := 0;
                      END;

                    IF change THEN
                      BEGIN
    {
                        FOR j := 0 TO 8 DO
                          IF KeyOff[j] AND (KeyOn[j].ins = 255) THEN
                            BEGIN
                              PutByteFile(f, $90+j);
                            END;
    }
                        FOR j := 0 TO 8 DO
                          IF KeyOn[j].ins < 255 THEN
                            BEGIN
                              PutByteFile(f, (j SHL 4) + KeyOn[j].ins);
                              PutByteFile(f, KeyOn[j].freq);
                              IF (KeyOn[j].freq AND $80) <> 0 THEN
                                PutByteFile(f, KeyOn[j].vol)
                              ELSE
                                Write(f, '     ');
                            END
                          ELSE
                            Write(f, '               ');
                      END;

                    FillChar(KeyOn,  SizeOf(KeyOn),  255);
                    FillChar(KeyOff, SizeOf(KeyOff),   0);

                    IF (v = $D) OR (v = $E) THEN
                      BEGIN
                        WHILE (v = $D) OR (v = $E) OR (v = $9) DO
                          BEGIN
                            IF v = $D THEN
                              INC(delta, r+1)
                            ELSE IF v = $E THEN
                              BEGIN
                                INC(i);
                                INC(delta, r*256+Music^[i]+1);
                              END;

                            INC(i);
                            v := Music^[i] SHR 4;
                            r := Music^[i] AND 15;
                          END;
                        DEC(i);
                      END
                    ELSE IF v = $F THEN
                      BEGIN
                        DBcol := 48;
                        PutByteFile(f, $FF);
                      END;
                  END;
          END;
        END;

      WriteLn(f);
      WriteLn(f);

    END;

  WriteLn(f);
  WriteLn(f);
  WriteLn(f, 'CMF_Offsets:');

  FOR k := 0 TO 3 DO
    WriteLn(f, '    DW 1, OFFSET CMF_Data', k, ', OFFSET CMF_Data', k);

  Close(f);
  St.Done;

END.